home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / ztfdd.exe / ZFDDTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-09  |  2.3 KB  |  108 lines
  1. program ztfddtest;
  2.  
  3. { A simple demo of the ZTFDD unit.
  4.   Look at the TMainWin.Paint() method for the ZTFDD usage }
  5.  
  6. uses WObjects, WinTypes, WinProcs, Strings, Ztfdd;
  7.  
  8. type
  9.  
  10.   { Define a TApplication descendant }
  11.   TMyApp = object(TApplication)
  12.     procedure InitMainWindow; virtual;
  13.   end;
  14.  
  15.   pMainWin = ^TMainWin;
  16.   TMainWin = object(TWindow)
  17.     tm : ttextmetric;
  18.     cxchar,cychar : integer;
  19.     constructor Init(AParent: PWindowsObject; Title: PChar);
  20.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  21.     procedure SetUpWindow; virtual;
  22.   end;
  23.  
  24. constructor tmainwin.Init(AParent: PWindowsObject; Title: PChar);
  25. begin
  26.   twindow.init(aparent, title);
  27. end;
  28.  
  29. procedure tmainwin.SetUpWindow;
  30. var
  31.   dc : hdc;
  32. begin
  33.   dc := getdc(hwindow);
  34.   gettextmetrics(dc,tm);
  35.   cxchar := tm.tmAveCharWidth;
  36.   cychar := tm.tmheight + tm.tmexternalleading;
  37.   releasedc(hwindow,dc);
  38. end;
  39.  
  40.  
  41. procedure tmainwin.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  42. const
  43.   Drives : array[0..4] of pchar = (
  44.     'cannot determine',
  45.     'Does not exist',
  46.     'Removable',
  47.     'Fixed',
  48.     'Remote');
  49.  
  50. var
  51.   r : trect;
  52.   y, i, j : integer;
  53.   l : longint;
  54.  
  55.   procedure ShowLine;
  56.   begin
  57.     textout(paintdc, 0, y, GetZ, strlen(getz));
  58.     inc(y,cychar);
  59.   end;
  60.  
  61. begin
  62.   y := 0;
  63.   getclientrect(hwindow,r);
  64.   write(zout, 'The client rectangle is',
  65.     r.left:4, r.top:4, r.right:4, r.bottom:4);
  66.   showline;
  67.  
  68.   l := getcurrentposition(paintdc);
  69.   write(zout, 'CurrentPosition = ', loword(l), ' ', hiword(l));
  70.   showline;
  71.  
  72.   write(zout, 'Milliseconds elapsed since system was booted: ', getcurrenttime);
  73.   showline;
  74.  
  75.   write(zout, 'Maxavail = ', maxavail, ', and MemAvail = ', memavail);
  76.   showline;
  77.  
  78.   write(zout, 'There are ', getnumtasks, ' tasks running.');
  79.   showline;
  80.  
  81.   inc(y,cychar);
  82.   for i := 0 to (ord('Z')-ord('A')) do begin
  83.     j := getdrivetype(i);
  84.     if j > 1 then begin
  85.       write(zout, 'Drive ', char(i+ord('A')), ' is ', Drives[j]);
  86.       showline;
  87.     end;
  88.   end;
  89. end;
  90.  
  91.  
  92. { Construct the THelloApp's MainWindow object }
  93. procedure TMyApp.InitMainWindow;
  94. begin
  95.   MainWindow := New(PMainwin, Init(nil, 'My Application'));
  96. end;
  97.  
  98. { Declare a variable of type THelloApp }
  99. var
  100.   HelloApp: TMyApp;
  101.  
  102. { Run the HelloApp }
  103. begin
  104.   HelloApp.Init('MyApp');
  105.   HelloApp.Run;
  106.   HelloApp.Done;
  107. end.
  108.